home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / hk / bas / hkmain.bas < prev    next >
Encoding:
BASIC Source File  |  1993-11-30  |  23.7 KB  |  623 lines
  1. 10 '------------------------------------------------------------------
  2. 20 '  HKMAIN.BAS  Copyrigit(C) T.Komura    / 家計簿システムHK    /
  3. 30 '                                       / Version 1           /
  4. 31 '  Version 1.0  1993.01.01 公開ﾊﾞｰｼﾞｮﾝ  / MAINプログラム      /
  5. 32 '          1.1  1993.07.26            
  6. 100 '------------------------------------------------------------------
  7. 150 DIM CFI$(15)
  8. 160 GOSUB *CONFIGファイルチェック
  9. 170 'LOCATE 0,5
  10. 175 'PRINT PRGDRV$,DATDRV$,RAMDRV$,TIFDRV$,FMBDRV$,SNDMF,SNDDRV$,SWAIT
  11. 180 'FOR II=1 TO 15:PRINT CFI$(II):NEXT II:STOP
  12. 190 '
  13. 193 VERN$="1.1" 'バージョンNo.
  14. 200 *初期設定:'--------------------------------------------------------
  15. 210 CMD$="CD "+PRGDRV$:SHELL CMD$
  16. 220 SCREEN@ 0 :COLOR 7,0,0,4:CLS:CONSOLE 0,24,0:MOUSE 0
  17. 230 DIM MSGD%(28000):' 音声メッセージ配列定義 プログラム先頭で定義
  18. 240 LOAD@ FMBDRV$+"\FMP.FMB"
  19. 250 PLAY "@30T150V6":DATX$=DATE$
  20. 260 DIM XB1(2,5),XB2(2,5),YB1(2,5),YB2(2,5),BST(2,5)
  21. 265 DIM DYN$(20),DRM$(20)
  22. 270 DIM CUTN#(795)
  23. 300 INTERVAL 1                  :'プログラム先頭
  24. 310 ON INTERVAL GOSUB *時計表示 :'プログラム先頭 
  25. 320 GOSUB *ボタン座標読み取り
  26. 330 'CLS:COLOR 7:PRINT int((int(((630-234+1)+7)/8)*(97-71+1)*4+8-1)/8)
  27. 370 ON ERROR GOTO *ERROR
  28. 380 '
  29. 1000 *メインルーチン:'･･･････････････････････････････････････････････････
  30. 1005 GOSUB *表紙表示
  31. 1010 MESN=21:GOSUB *SNDMSG
  32. 1020 GOSUB *本日の日付
  33. 1035 MOUSE 1,320,64,1
  34. 1040 GOSUB *HLIDXファイルチェック
  35. 1100 *メイン選択
  36. 1110 '
  37. 1130 SWPASS=1:G=1:GOSUB *マウスボタン選択
  38. 1145 IF SWNO>5 THEN *メイン選択
  39. 1150 ON SWNO GOTO *S01,*S02,*S03,*S04,*S05
  40. 1160 GOTO 1100:STOP
  41. 2000 *S01
  42. 2020  G=1:B=1:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  43. 2030  CHAIN "HKIN.BAS"
  44. 2100 *S02
  45. 2120  G=1:B=2:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  46. 2130  CHAIN "HKSRCH.BAS"
  47. 2200 *S03
  48. 2220  G=1:B=3:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  49. 2230  CHAIN "HKANLY.BAS"
  50. 2300 *S04
  51. 2320  G=1:B=4:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  52. 2330  CHAIN "HKCFG.BAS"
  53. 3390 '
  54. 3490 '
  55. 8940 '
  56. 9000 *S05:'終了････････････････････････････････････････････････････････
  57. 9020 G=1:B=5:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  58. 9110 MESN=6:GOSUB *SNDMSG
  59. 9120 FOR II=1 TO 5000:NEXT II
  60. 9130 MOUSE 5:GOSUB *FADEOUT
  61. 9140 SHELL "cd \"
  62. 9150 SYSTEM
  63. 9160 '
  64. 9900 '-------------------------------------------------------------------
  65. 9910 '    ＧＥＮＥＲＡＬ　ＳＵＢ　ＲＯＵＴＩＮＥ
  66. 9920 '-------------------------------------------------------------------
  67. 10000 *CHR1IN:'////////// 1文字入力
  68. 10010  A$=INKEY$:IF A$="" THEN 10010
  69. 10020  A=INSTR(C$,A$)
  70. 10030  IF A=0 THEN MESN=13:GOSUB *SNDMSG:GOTO 10010
  71. 10040  RETURN
  72. 10050 '
  73. 10060 '
  74. 10990 '
  75. 11000 *SNDMSG:'  SAVE "SNDMSG.SUB",A
  76. 11005  IF SNDMF=0 THEN RETURN
  77. 11010  '･････････････････  サウンドメッセージ実行サブルーチン  1989.02.04
  78. 11020  '                   入力=MESN (メッセージNo.)
  79. 11030  '
  80. 11070  IF MESN>36 THEN *RETURN_SNDMSG :'END
  81. 11080  RESTORE *MSGNAM
  82. 11090  FOR IMSG=1 TO MESN
  83. 11100    READ MSGD$
  84. 11110  NEXT IMSG
  85. 11120  MSGFN$=SNDDRV$+"\"+MSGD$+"_F.SND"
  86. 11130  LOAD@ MSGFN$,MSGD%
  87. 11140  PCMPLAY MSGD%:WAIT SWAIT
  88. 11150 *RETURN_SNDMSG :RETURN
  89. 11160 *MSGNAM :'////////// .SND File Name Data
  90. 11170 DATA "OHA1"   :'  1 おはよう
  91. 11180 DATA "KONN"   :'  2 こんにちわ
  92. 11190 DATA "KONBAN" :'  3 こんばんわ
  93. 11200 DATA "GOKRO1" :'  4 ごくろうさん
  94. 11210 DATA "GOKRO2" :'  5 ごくろうさま
  95. 11220 DATA "OTUKA"  :'  6 お疲れさま
  96. 11230 DATA "OMATA"  :'  7 おまたせ
  97. 11240 DATA "ARIGA2" :'  8 ありがとう
  98. 11250 DATA "RUNRUN" :'  9 るんるん
  99. 11260 DATA "DAMEDE" :' 10 だめでしょう
  100. 11270 DATA "IIDE1"  :' 11 いいですか
  101. 11280 DATA "NANISI" :' 12 なにしてるの
  102. 11290 DATA "DAMEDA" :' 13 だめだめ
  103. 11300 DATA "OWARI"  :' 14 終わりました
  104. 11310 DATA "SIBA"   :' 15 しばらくお待ち下さい
  105. 11320 DATA "YOROSI" :' 16 よろしいですか
  106. 11330 DATA "TYANTO" :' 17 ちゃんとしなさい
  107. 11340 DATA "ERANDE" :' 18 選んでください
  108. 11350 DATA "KAKNIN" :' 19 確認して下さい
  109. 11360 DATA "NYURYO" :' 20 入力してください
  110. 11370 DATA "IRA"    :' 21 いらっしゃいませ 
  111. 11380 DATA "OYASUM" :' 22 おやすみ
  112. 11390 DATA "ARIGA3" :' 23 ありがとうございました
  113. 11400 DATA "TYOTO"  :' 24 ちょっと待って
  114. 11410 DATA "DAMEYO" :' 25 駄目よ
  115. 11420 DATA "YAMETE" :' 26 やめて
  116. 11430 DATA "TIGAU"  :' 27 ちがうよ
  117. 11440 DATA "PINPON" :' 28 ぴんぽーん
  118. 11450 DATA "BUU"    :' 29 ぶー
  119. 11460 DATA "MOUII"  :' 30 もういいよう  
  120. 11470 DATA "DEKITA" :' 31 できたよー
  121. 11480 DATA "IIDE2"  :' 32 いいですか（２）
  122. 11490 DATA "YOSI"   :' 33 よしなさい
  123. 11500 DATA "OYOSI"  :' 34 およしなさい
  124. 11510 DATA "YAMENA" :' 35 やめなさい
  125. 11520 DATA "GOMEN"  :' 36 ごめん
  126. 11530 '                                    
  127. 12000 '////////// 年月日入力 & 曜日表示
  128. 12010 '                    
  129. 12045 *週検索
  130. 12050 DATA "日",2,"月",0,"火",0,"水",0,"木",0,"金",0,"土",5
  131. 12060 GOSUB *WEEKN:RESTORE 12050:FOR IW=0 TO WK:READ WKM$,CW:NEXT IW
  132. 12080 RETURN
  133. 12090 '
  134. 12100 *YMDIN            '  V2.0  1991.07.21
  135. 12110 LX=XYMD:LY=YYMD:LC=CYMD:LL=4:LM$=INYR$:LINS=0
  136. 12120 LOCATE LX,LY:COLOR BYMD:PRINT "    年   月  日";
  137. 12130 LOCATE LX,LY:COLOR CYMD:PRINT LM$:GOSUB *LKEYIN: INYR$=LMG$
  138. 12140 LOCATE LX,LY:COLOR AYMD:PRINT LMG$
  139. 12145 YR=VAL(INYR$)
  140. 12150 LX=XYMD+7:LY=YYMD:LC=CYMD:LL=2:LM$=INMN$:LINS=0
  141. 12160 LOCATE LX,LY:COLOR CYMD:PRINT LM$:GOSUB *LKEYIN: INMN$=LMG$
  142. 12170 LOCATE LX,LY:COLOR AYMD:PRINT LMG$
  143. 12175 MN=VAL(INMN$):IF MN<1 OR MN>12 THEN BEEP:GOTO 12160
  144. 12180 LX=XYMD+11:LY=YYMD:LC=CYMD:LL=2:LM$=INDY$:LINS=0
  145. 12190 LOCATE LX,LY:COLOR CYMD:PRINT LM$:GOSUB *LKEYIN: INDY$=LMG$
  146. 12200 LOCATE LX,LY:COLOR AYMD:PRINT LMG$
  147. 12205 DY=VAL(INDY$):IF DY<1 OR DY>31 THEN BEEP:GOTO 12190
  148. 12210 RETURN
  149. 12220 '
  150. 12450 *WEEKN :'////////// 週NO.検索
  151. 12460 U=0    :'････････････････････････ Input; YR MN   Output; WK DN
  152. 12470 IF YR/4-INT(YR/4)=0 THEN U=1
  153. 12480 DATA 31,28,31,30,31,30,31,31,30,31,30,31
  154. 12490 DATA 31,29,31,30,31,30,31,31,30,31,30,31
  155. 12500 IF U=0 THEN RESTORE 12480 ELSE RESTORE 12490
  156. 12505 IF MN=1 THEN MDN=0:MNDN=31:GOTO 12520
  157. 12510 MDN=0:FOR IWEKN=1 TO MN-1:READ DN:MDN=MDN+DN:NEXT IWEKN
  158. 12515 READ MNDN:'当月の日数
  159. 12520 YDN#=MDN+YR*365+INT((YR+3)/4)+5+DY-1
  160. 12530 WK=(YDN#/7-INT(YDN#/7))*7
  161. 12540 RETURN
  162. 13000 '/////////////////////////////////////////////////////////////////
  163. 13001 ' LKEYIN   v1.1a 全角文字移動改良              1993.02.12 T.Komura
  164. 13002 '--------- v1.2  挿入モードの変更他全面bugFIX  1993.08.04 T.Komura
  165. 13003 '
  166. 13010 *LKEYIN  :'･･･････････ 1 行全角文字入力サブルーチン
  167. 13011 '   入力 = LX,LY : 表示開始座標       出力 = LMG$ : 入力後の文字列
  168. 13012 '          LM$   : 初期文字列
  169. 13013 '          LC    : 表示文字色
  170. 13014 '          LL    : 最大文字数
  171. 13015 '          LINS  : 挿入ﾓｰﾄﾞ=1
  172. 13016 '
  173. 13020  LCSRCL=1:LLINCL=6
  174. 13030 '           CR   MR   ML  INS  DEL   BS  CAN
  175. 13040  LMSX=MOUSE(0):LMSY=MOUSE(1):MOUSE 5      :'v1.1a
  176. 13050  CC$=CHR$(&H0D,&H1C,&H1D,&H12,&H7F,&H08,&H18)
  177. 13060  LMG$=SPACE$(LL):LMGD$=SPACE$(LL)
  178. 13070  LA$=INKEY$:IF LA$<>"" THEN 13070
  179. 13080  IF LINS=1 THEN CWDT=1 ELSE CWDT=7
  180. 13090  LCSR=0:LCSRX=LCSR:GOSUB *LCSRDX
  181. 13100  LOCATE LX,LY:COLOR LC:PRINT LM$ '       ･･････････ 初期文字列表示
  182. 13110  LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  183. 13120  LMX$=LEFT$(LM$+SPACE$(LL),LL)
  184. 13130  GOSUB *LMREAD
  185. 13140 *IN1C:'                                  ･･････････ 1 文字入力
  186. 13150  LA$=INKEY$:IF LA$="" THEN 13150
  187. 13160  ALA=ASC(LA$):CLA=INSTR(CC$,LA$)
  188. 13170  IF CLA=0 THEN 13190
  189. 13180  ON CLA GOTO *CR,*MR,*ML,*INS,*DEL,*BS,*CAN
  190. 13190  IF KANF=1 THEN *KANJI
  191. 13200  IF ALA<&H20 THEN BEEP:GOTO *IN1C
  192. 13210  IF ALA>=&H20 AND ALA<&H80 THEN *ANK
  193. 13220  IF ALA>=&HA0 AND ALA<&HE0 THEN *ANK
  194. 13230  GOTO *KANJI
  195. 13240 *ANK :'                                  ･･････････ ANK 文字入力
  196. 13250  IF LINS=1 THEN 13270
  197. 13260  MID$(LMX$,LCSR+1,1)=LA$:GOTO 13280
  198. 13270  LMX$=LEFT$(LMX$,LCSR)+LA$+RIGHT$(LMX$,LL-LCSR)
  199. 13280  GOSUB *LCSRINC
  200. 13290  GOSUB *LMREAD1:GOSUB *LMXDSP
  201. 13300  GOTO *IN1C
  202. 13310 *KANJI :'                                ･･････････ 漢字文字入力
  203. 13320  ON KANF+1 GOTO 13330,13360
  204. 13330  KANF=1:KANW$="":KANW$=LA$
  205. 13340    IF LCSR+1>=LL THEN KANF=0:BEEP
  206. 13350    GOSUB *LCSRD:GOTO *IN1C
  207. 13360  KANF=0:KANW$=KANW$+LA$
  208. 13370    IF LINS=1 THEN 13390
  209. 13380    MID$(LMX$,LCSR+1,2)=KANW$:GOTO 13400
  210. 13390    LMX$=LEFT$(LMX$,LCSR)+KANW$+RIGHT$(LMX$,LL-LCSR)
  211. 13400    GOSUB *LCSR2INC
  212. 13410    GOSUB *LMREAD1:GOSUB *LMXDSP
  213. 13420  GOTO *IN1C
  214. 13430 *CR :GOSUB *LMREAD:GOSUB *LCSRDX         '////////// End
  215. 13440  LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  216. 13450  MOUSE 0: MOUSE 1,LMSX,LMSY,1     :'v1.1a
  217. 13460 RETURN:'----------------------------------------------------------
  218. 13470 *MR :GOSUB *LMREAD2                      '////////// Right
  219. 13480      IF LMGF$="1" THEN GOSUB *LCSR2INC:GOTO *IN1C
  220. 13490                        GOSUB *LCSRINC :GOTO *IN1C
  221. 13500 *ML :GOSUB *LMREAD2                      '////////// Left
  222. 13510      IF LMGB$="2" THEN GOSUB *LCSR2DEC:GOTO *IN1C
  223. 13520                        GOSUB *LCSRDEC :GOTO *IN1C
  224. 13530 *INS:GOSUB *LCSRDX:LINS=1-LINS           '////////// Insert
  225. 13540      IF LINS=1 THEN CWDT=1 ELSE CWDT=7
  226. 13550      GOSUB *LCSRDX                    :GOTO *IN1C
  227. 13560 *DEL:GOSUB *LMREAD:LMX$=LEFT$(LMG$,LCSR) '////////// Delete
  228. 13570      IF LMGF$="1" THEN LDEF=2 ELSE LDEF=1
  229. 13580      LMX$=LMX$+MID$(LMG$,LCSR+LDEF+1,LL-LCSR-LDEF)+"  "
  230. 13590      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  231. 13600 *BS :GOSUB *LMREAD                       '////////// BackSpace
  232. 13610      IF LCSR=0 THEN GOTO *IN1C
  233. 13620      IF LMGB$="2" THEN GOSUB *LCSR2DEC:LDEF=2:GOTO 13640
  234. 13630                        GOSUB *LCSRDEC :LDEF=1:GOTO 13640
  235. 13640      LMX$=LEFT$(LMG$,LCSR)+RIGHT$(LMG$,LL-LCSR-LDEF)+"  "
  236. 13650      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  237. 13660 *CAN :LMX$=SPACE$(LL)                    '////////// Clear
  238. 13670      GOSUB *LMXDSP:LCSR=0:GOSUB *LCSRD
  239. 13680      GOSUB *LMREAD                    :GOTO *IN1C
  240. 13690 *LMREAD:                                 '////////// Disp Char Read 
  241. 13700      LMGFX$=MID$(LMGDX$,LCSR+1,1)
  242. 13710      IF LMGFX$="2" OR LMGF$="2" THEN MID$(LMX$,LCSR+1,1)=" "
  243. 13720 *LMREAD1:LMGD$=""
  244. 13730          FOR II=1 TO KLEN(LMX$)
  245. 13740            LMG=KTYPE(LMX$,II)
  246. 13750            IF LMG=0 THEN LMD$="0" ELSE LMD$="12"
  247. 13760            LMGD$=LMGD$+LMD$
  248. 13770          NEXT II
  249. 13780          IF LEN(LMGD$)<=LL THEN 13800
  250. 13790          LMGD$=LEFT$(LMGD$,LL):LMX$=LEFT$(LMX$,LL)
  251. 13800          IF RIGHT$(LMGD$,1)<>"1" THEN 13820
  252. 13810          MID$(LMGD$,LL,1)="0":MID$(LMX$,LL,1)=" "
  253. 13820 *LMREAD2:LMGF$=MID$(LMGD$,LCSR+1,1)
  254. 13830          IF LCSR=0 THEN LMGB$="0" ELSE LMGB$=MID$(LMGD$,LCSR,1)
  255. 13840          LMG$=LMX$:LMGDX$=LMGD$
  256. 13850          RETURN
  257. 13860 *LCSRD :LXC=8*(LX+LCSR) :LYC=LY*19:GOSUB *LCSRL: '//// Csr Disp
  258. 13870 *LCSRDX:LXC=8*(LX+LCSRX):LYC=LY*19:GOSUB *LCSRL: '//// Csr Erace
  259. 13880         LCSRX=LCSR:RETURN
  260. 13890 *LCSRL :LINE(LXC,LYC+0)-(LXC+CWDT,LYC+14),XOR,LCSRCL,BF:RETURN
  261. 13900 *LCSRINC :LCSR=LCSR+1:IF LCSR>=LL THEN LCSR=LL-1
  262. 13905           GOSUB *LCSRD:RETURN
  263. 13910 *LCSR2INC:LCSR=LCSR+2:IF LCSR>=LL THEN LCSR=LL-2
  264. 13915           GOSUB *LCSRD:RETURN
  265. 13920 *LCSRDEC :LCSR=LCSR-1:IF LCSR<0 THEN LCSR=0
  266. 13925           GOSUB *LCSRD:RETURN
  267. 13930 *LCSR2DEC:LCSR=LCSR-2:IF LCSR<0 THEN LCSR=LCSR+2
  268. 13935           GOSUB *LCSRD:RETURN
  269. 13940 *LMXDSP  :LOCATE LX,LY:COLOR LC:PRINT LMX$;:RETURN
  270. 13950 '-------------------------------------------------------------------
  271. 15000 '
  272. 15010 '  SAVE"TCLOCK.sub"             :'   組み込み型 アナログ時計 V1.1
  273. 15020 '                                       1991.05 T.KOMURA 
  274. 15030 '--------------------------------------------------------------------
  275. 15040 '
  276. 15220 *時計表示:'///////////////////////////////////
  277. 15230 XCLK0=572:YCLK0=22:CLKR=16:PI=3.1415!
  278. 15240 TIMEX$=TIME$:IF DATE$<>DATX$ THEN GOSUB *本日の日付
  279. 15250 TSC$=MID$(TIMEX$,7,2):SCR=2*PI*(VAL(TSC$)/60)
  280. 15260 TMN$=MID$(TIMEX$,4,2):MNR=2*PI*(VAL(TMN$)/60)
  281. 15270 THR$=LEFT$(TIMEX$,2) :HRR=2*PI*((VAL(THR$)*60+VAL(TMN$))/720)
  282. 15280 GOSUB *短針表示
  283. 15290 GOSUB *長針表示
  284. 15300 GOSUB *秒針表示
  285. 15310 CLOCKINIT=1:DATX$=DATE$
  286. 15320 RETURN
  287. 15330 '
  288. 15340 *短針表示
  289. 15350 XHD1=XCLK0+(CLKR-8)*SIN(HRR):XHD2=XCLK0
  290. 15360 YHD1=YCLK0-(CLKR-8)*COS(HRR):YHD2=YCLK0
  291. 15370 IF CLOCKINIT=0 THEN 15400
  292. 15380 IF SCR<>0 THEN 15420
  293. 15390 LINE(XHD1X,YHD1X)-(XHD2X,YHD2X),XOR,6
  294. 15400 LINE(XHD1 ,YHD1 )-(XHD2 ,YHD2 ),XOR,6
  295. 15410 XHD1X=XHD1:YHD1X=YHD1:XHD2X=XHD2:YHD2X=YHD2
  296. 15420 RETURN
  297. 15430 *長針表示
  298. 15440 XMD1=XCLK0+(CLKR-2)*SIN(MNR):XMD2=XCLK0
  299. 15450 YMD1=YCLK0-(CLKR-2)*COS(MNR):YMD2=YCLK0
  300. 15460 IF CLOCKINIT=0 THEN 15490
  301. 15470 IF SCR<>0 THEN 15510
  302. 15480 LINE(XMD1X,YMD1X)-(XMD2X,YMD2X),XOR,7
  303. 15490 LINE(XMD1 ,YMD1 )-(XMD2 ,YMD2 ),XOR,7
  304. 15500 XMD1X=XMD1:YMD1X=YMD1:XMD2X=XMD2:YMD2X=YMD2
  305. 15510 RETURN
  306. 15520 *秒針表示
  307. 15530 XSD1=XCLK0+(CLKR)*SIN(SCR):XSD2=XCLK0:'+(CLKR-10)*SIN(SCR)
  308. 15540 YSD1=YCLK0-(CLKR)*COS(SCR):YSD2=YCLK0:'-(CLKR-10)*COS(SCR)
  309. 15550 IF CLOCKINIT=0 THEN 15570
  310. 15560 LINE(XSD1X,YSD1X)-(XSD2X,YSD2X),XOR,4
  311. 15570 LINE(XSD1 ,YSD1 )-(XSD2 ,YSD2 ),XOR,4
  312. 15580 XSD1X=XSD1:YSD1X=YSD1:XSD2X=XSD2:YSD2X=YSD2
  313. 15590 RETURN
  314. 16000 '
  315. 19000 '
  316. 19010 '//////////////////////////////////////////////////////////////
  317. 19020 *ERROR:'      エラー処理サブルーチン V1.10   1990.11.08 T.Komura
  318. 19030 '             
  319. 19040 '
  320. 19050 IF ERR=53 THEN *IOERR
  321. 19060 IF ERR=63 THEN *FILNOF
  322. 19070 IF ERR=67 THEN *DSKFUL
  323. 19080 IF ERR=71 THEN *DSKUNF 
  324. 19090 IF ERR=72 THEN *DSKOFF
  325. 19100 IF ERR=73 THEN *DSKWP
  326. 19110 ERMES$="エラー行:"+STR$(ERL)+" エラー番号:"+STR$(ERR)+" 発生"
  327. 19120 GOSUB *ERMSG
  328. 19130 STOP
  329. 19140 '////////// エラー処理
  330. 19150 *IOERR
  331. 19160 ERMES$="ﾌﾟﾘﾝﾀｰが準備されていません｡ ﾌﾟﾘﾝﾀｰをセット後､"
  332. 19170 GOSUB *ERMSG:RESUME
  333. 19180 *DSKFUL
  334. 19190 ERMES$="ディスクが満杯です｡ 交換後､"
  335. 19200 GOSUB *ERMSG:RESUME
  336. 19210 *DSKUNF
  337. 19220 ERMES$="このディスクは使用出来ません｡処理を中断します｡ "
  338. 19230 GOSUB *ERMSG:RESUME
  339. 19240 *DSKOFF
  340. 19250 ERMES$="ディスク装置が準備されていません｡ディスクをセット後､"
  341. 19260 GOSUB *ERMSG:RESUME
  342. 19270 *DSKWP
  343. 19280 ERMES$="ディスクが書き込み禁止になっています｡解除後､"
  344. 19290 GOSUB *ERMSG:RESUME
  345. 19300 *FILNOF
  346. 19310 ERMES$="ファイルが見つかりません｡ディスクを交換後､"
  347. 19320 GOSUB *ERMSG:RESUME
  348. 19330 '
  349. 19340 *ERMSG:'////////// エラーメッセージ
  350. 19350 LOCATE 2,23:COLOR 2,0
  351. 19355 PRINT SPACE$(77);
  352. 19359 LOCATE 2,23:COLOR 2,0
  353. 19360 PRINT ERMES$;"[実行]キーを押してね！";
  354. 19370 COLOR 7,0:MESN=19:GOSUB *SNDMSG
  355. 19380 ERRA$=INKEY$:IF ERRA$="" THEN 19380
  356. 19390 IF ERRA$<>CHR$(&H0D) THEN 19380
  357. 19400 LOCATE 3,23:COLOR 6,0
  358. 19410 PRINT "エラー処理を終わります｡";SPACE$(52);
  359. 19420 RETURN
  360. 19430 '
  361. 19440 '
  362. 19450 '
  363. 20000 '------------------------------------------------------------------
  364. 20010 ' ＣＵＳＴＯＭ　ＳＵＢ　ＲＯＵＴＩＮＥ FOR "DOQSO.BAS"
  365. 20020 '------------------------------------------------------------------
  366. 20100 *表紙表示
  367. 20105  PLAY "L16O7C<BAG>C<BAGR2>C<BAG>C<G>L4C"
  368. 20140  'RANDOMIZE TIME/3
  369. 20155  LOAD@ TIFDRV$+"\MAINb.tif",(0,0)
  370. 20160  INTERVAL ON
  371. 20180  RETURN
  372. 20190 '
  373. 20200 *HLIDXファイルチェック
  374. 20210  GOSUB *HKIOPN:CLOSE
  375. 20220  IF IR>0 THEN RETURN
  376. 20230  LOCATE 2,22:COLOR 6
  377. 20235  PRINT "ｲﾝﾃﾞｯｸｽﾌｧｲﾙがありません｡家計簿システム用のディスクを作成しますか?";
  378. 20240  CMES$="家計簿データディスク作成":GOSUB *確認
  379. 20245  LOCATE 2,22:PRINT SPACE$(76);
  380. 20250  ON SWNO GOTO 20260,*S04
  381. 20260  GOSUB *ファイル年月入力
  382. 20300  GOSUB *新規ファイル作成
  383. 20310  RETURN
  384. 20390 '
  385. 20400 *ファイル年月入力
  386. 20410  LOCATE 2,22:COLOR 7,0
  387. 20420  PRINT "何年何月の家計簿ファイルを作成しますか? ";
  388. 20430  SYMBOL(8*54,22*19),"    年   月",1,1,7,,,&H01
  389. 20440  GOSUB *本日の日付2
  390. 20450  YR$=TY$:MN$=TM$:LINS=0
  391. 20470  LM$=YR$:LL=4:LC=5:LX=54:LY=22:GOSUB *LKEYIN
  392. 20475  YR$=LMG$:LINS=0
  393. 20480  LM$=MN$:LL=2:LC=5:LX=61:LY=22:GOSUB *LKEYIN
  394. 20485  MN$=LMG$
  395. 20510  LOCATE 2,22:COLOR 7,0
  396. 20520  PRINT YR$;"年";MN$;"月の家計簿ファイルを作成します｡";
  397. 20540  RETURN
  398. 20550 '
  399. 20700 *新規ファイル作成
  400. 20760  CMES$="["+YR$+"年"+MN$+"月]ファイル新規作成"
  401. 20770  GOSUB *確認
  402. 20780  ON SWNO GOTO 20800,*S04
  403. 20800  MESN=24:GOSUB *SNDMSG
  404. 20810  IYM$=YR$+MN$:IMAK$=SPACE$(32):'--------------IDX追加
  405. 20820  RI=IR+1:GOSUB *HKIPUT
  406. 20830  DEV$=SPACE$(64):DDM$=SPACE$(32):'------------ファイル作成
  407. 20835  FOR JJ=1 TO 16:DYN$(JJ)=SPACE$(10):DRM$(JJ)=SPACE$(32):NEXT JJ
  408. 20840  FOR RDY=1 TO 31
  409. 20845    LOCATE 70,22:COLOR 4:PRINT RIGHT$(STR$(RDY),2);" / 31";
  410. 20850    GOSUB *HKDPUT
  411. 20860  NEXT RDY:MESN=14:GOSUB *SNDMSG:LOCATE 70,23:PRINT SPACE$(8);
  412. 20870  RETURN
  413. 20880 '
  414. 20900 STOP
  415. 21000 *本日の日付2
  416. 21010  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  417. 21020  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  418. 21030  TY$=RIGHT$(STR$(TY),4)
  419. 21040  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  420. 21050  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  421. 21100  RETURN
  422. 21110 '
  423. 22200 *本日の日付
  424. 22210  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  425. 22212  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  426. 22214  TY$=RIGHT$(STR$(TY),4)
  427. 22220  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  428. 22230  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  429. 22250  YR=TY:MN=TM:DY=TD:GOSUB *週検索:IF CW=0 THEN CW=7
  430. 22260  TYMD$=TY$+"年"+TM$+"月"+TD$+"日"+"   曜日"
  431. 22265  COLOR 7,0:LOCATE 46,1:PRINT TYMD$
  432. 22270  COLOR CW:LOCATE 61,1:PRINT WKM$
  433. 22280  RETURN
  434. 22290 '
  435. 22630 '
  436. 22900 '------------------------------------------------------------------
  437. 30130 *ボタン座標読み取り
  438. 30140  RESTORE *ボタン座標:READ SWGN
  439. 30150  FOR G=1 TO SWGN
  440. 30160    READ SWN(G),SMX(G),SMY(G),SMW(G)
  441. 30170    FOR B=1 TO SWN(G)
  442. 30180      READ XB1(G,B),XB2(G,B),YB1(G,B),YB2(G,B)
  443. 30190    NEXT B
  444. 30200  NEXT G
  445. 30210  RETURN
  446. 30220 '
  447. 30230 *ボタンON_OFF表示
  448. 30240  IF BST(G,B)=1 THEN BSC=7:BSB=0:BSA=2:GOTO 30260
  449. 30250                    BSC=0:BSB=7:BSA=5
  450. 30260   CONNECT(XB1(G,B  ),YB2(G,B)  )-(XB2(G,B)  ,YB2(G,B)  )-(XB2(G,B  ),YB1(G,B)  ),BSC,PSET
  451. 30270   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB2(G,B)-1,YB2(G,B)-1)-(XB2(G,B)-1,YB1(G,B)+1),BSC,PSET
  452. 30280   CONNECT(XB1(G,B)  ,YB2(G,B)  )-(XB1(G,B)  ,YB1(G,B)  )-(XB2(G,B)  ,YB1(G,B)  ),BSB,PSET
  453. 30290   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB1(G,B)+1,YB1(G,B)+1)-(XB2(G,B)-1,YB1(G,B)+1),BSB,PSET
  454. 30300   LINE(XB1(G,B)+4,YB1(G,B)+4)-(XB1(G,B)+6,YB1(G,B)+5),PSET,BSA,BF
  455. 30305   IF BST(G,B)=1 THEN SMSGPLAY 0:WAIT 16
  456. 30310  RETURN
  457. 30320 '
  458. 30330 *マウスボタン選択
  459. 30340  SWERC=0
  460. 30350  IF MOUSE(2,0)=0 THEN 30350
  461. 30360  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):SWNO=0
  462. 30370  FOR IMS=1 TO SWN(G)
  463. 30380    IF (X_M>XB1(G,IMS) AND X_M<XB2(G,IMS)) ELSE 30410
  464. 30390    IF (Y_M>YB1(G,IMS) AND Y_M<YB2(G,IMS)) ELSE 30410
  465. 30400    SWNO=IMS:IMS=SWN(G)+1
  466. 30410  NEXT IMS:FOR IM=1 TO 500:NEXT IM
  467. 30430  IF SWNO=0 AND SWERC>5  THEN MESN=12:GOSUB *SNDMSG       :GOTO 30350
  468. 30440  IF SWNO=0              THEN SMSGPLAY 3:SWERC=SWERC+1:GOTO 30350
  469. 30460  SWPASS=0
  470. 30470  RETURN
  471. 30480 '
  472. 31000 *FADEOUT:CLS 1:CONSOLE 0,24,0
  473. 31010  FOR II=0 TO 15
  474. 31020    PALETTE II,[16*II,16*II,16*II]
  475. 31030  NEXT II
  476. 31040  FOR II=0 TO 255 STEP 5:WAIT SWAIT/50
  477. 31050    FOR JJ=0 TO 15:KK=16*JJ+II*(255-16*JJ)/255
  478. 31054      PALETTE JJ,[KK,KK,KK]
  479. 31056    NEXT JJ
  480. 31060  NEXT II
  481. 31070  RETURN
  482. 31080 '
  483. 31200 *確認
  484. 31205  LOCATE 27,3:PRINT SPACE$(52)
  485. 31210  GET@A(214,50)-(630,79),CUTN#
  486. 31220  LOAD@ TIFDRV$+"\CAUTION2.TIF",(214,50)
  487. 31230  FOR II=1 TO 4
  488. 31232    LOCATE 40,3:COLOR 6:PRINT CMES$;:'28chr
  489. 31234    WAIT SWAIT/10
  490. 31236    LOCATE 40,3:PRINT SPACE$(28)
  491. 31237    WAIT SWAIT/10
  492. 31238  NEXT II
  493. 31239  LOCATE 40,3:COLOR 7:PRINT CMES$;:MESN=19:GOSUB *SNDMSG
  494. 31240  G=2:GOSUB *マウスボタン選択
  495. 31245  G=2:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  496. 31250  LOCATE 40,3:PRINT SPACE$(28)
  497. 31260  FOR II=1 TO 1000:NEXT II
  498. 31270  PUT@A(214,50)-(630,79),CUTN#
  499. 31272  'GOSUB *日付表示
  500. 31275  RETURN
  501. 31280 '
  502. 35000 *HKIOPN:'---------- インデックスファイルオープン
  503. 35005  DRV$=LEFT$(DATDRV$,2)
  504. 35010  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35020
  505. 35015  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  506. 35020  FLN$=DRV$+"(38)"+PATH$+"\HLIDX.DAT"
  507. 35030  OPEN "R",#2,FLN$
  508. 35040  FIELD #2,6 AS I$(1),32 AS I$(2)
  509. 35050  IR=LOF(2)
  510. 35060  RETURN
  511. 35070 '
  512. 35100 *HKDOPN:'---------- 家計簿データファイルオープン
  513. 35105  DRV$=LEFT$(DATDRV$,2)
  514. 35110  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35120
  515. 35115  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  516. 35120  FLN$=DRV$+"(768)"+PATH$+"\HL"+IYM$+".DAT"
  517. 35130  OPEN "R",#1,FLN$
  518. 35140  FIELD #1,64 AS D$(1),10*16 AS D$(2),32*4 AS D$(3),32*4 AS D$(4),32*4 AS D$(5),32*4 AS D$(6),32 AS D$(7)
  519. 35150  AR=LOF(1)
  520. 35160  RETURN
  521. 35170 '
  522. 36100 *HKIPUT:'---------- インデックスファイル作成
  523. 36110  GOSUB *HKIOPN
  524. 36120  LSET I$(1)=IYM$
  525. 36130  LSET I$(2)=IMK$
  526. 36140  PUT #2,RI
  527. 36150  CLOSE #2
  528. 36160  RETURN
  529. 36170 '
  530. 36300 *HKDPUT:'---------- 家計簿データ書き込み
  531. 36310  GOSUB *HKDOPN
  532. 36320  R=RDY
  533. 36330  LSET D$(1)=DEV$
  534. 36340  DX$="":FOR II=1 TO 16:DX$=DX$+DYN$(II   ):NEXT II:LSET D$(2)=DX$
  535. 36342  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 0):NEXT II:LSET D$(3)=DX$
  536. 36343  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 4):NEXT II:LSET D$(4)=DX$
  537. 36344  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 8):NEXT II:LSET D$(5)=DX$
  538. 36345  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+12):NEXT II:LSET D$(6)=DX$
  539. 36346  LSET D$(7)=DDM$
  540. 36350  PUT #1,R
  541. 36360  CLOSE #1
  542. 36370  RETURN
  543. 36380 '
  544. 37190 '
  545. 37290 '
  546. 39000 '//////////////////////////////////////////////////
  547. 39010 *CONFIGファイルチェック'  V1.1 1993.08.04
  548. 39020 '                         FOR HK T.Komura
  549. 39030  OPEN "R",#1,"(1)HK.CFG"
  550. 39040  FIELD #1,1 AS D$
  551. 39050  IF LOF(1)=0 THEN *CFGFE1
  552. 39060  CLOSE
  553. 39070  OPEN "I",#1,"HK.CFG"
  554. 39080  GOSUB *CFGREAD:PRGDRV$=CFG$:'-- PRGDRV$
  555. 39090  GOSUB *CFGREAD:DATDRV$=CFG$:'-- DATDRV$
  556. 39100  GOSUB *CFGREAD:RAMDRV$=CFG$:'-- RAMDRV$
  557. 39110  TIFDRV$=PRGDRV$+"\TIFF"    :'-- TIFDRV$
  558. 39120  GOSUB *CFGREAD:FMBDRV$=CFG$:'-- FMBDRV$
  559. 39130  GOSUB *CFGREAD             :'-- SNDMF
  560. 39140    IF LEFT$(CFG$,5)<>"SNDMF" THEN *CFGFE2
  561. 39150    SNDMF=VAL(RIGHT$(CFG$,1))
  562. 39160  GOSUB *CFGREAD:SNDDRV$=CFG$:'-- SNDDRV$
  563. 39170  GOSUB *CFGREAD             :'-- SWAIT
  564. 39180    IF LEFT$(CFG$,4)<>"WAIT" THEN *CFGFE2
  565. 39190    SWAIT=VAL(RIGHT$(CFG$,LEN(CFG$)-5))
  566. 39200  FOR II=1 TO 15
  567. 39210    GOSUB *CFGREAD:CFI$(II)=CFG$
  568. 39220  NEXT II
  569. 39230  GOSUB *CFGREAD             :'-- DICIF
  570. 39240    IF LEFT$(CFG$,5)<>"DICIF" THEN *CFGFE2
  571. 39250    DICIF=VAL(RIGHT$(CFG$,1))
  572. 39260  GOSUB *CFGREAD             :'-- DICSF
  573. 39270    IF LEFT$(CFG$,5)<>"DICSF" THEN *CFGFE2
  574. 39280    DICSF=VAL(RIGHT$(CFG$,1))
  575. 39290  GOSUB *CFGREAD:DICDRV$=CFG$:'-- DICDRV$
  576. 39300  CLOSE
  577. 39310  RETURN
  578. 39320 '---------------------------------------------
  579. 39330 *CFGFE1
  580. 39340  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルが見当たりません｡ 家計簿を終了します｡"
  581. 39350  CLOSE:WAIT 100:SYSTEM
  582. 39360 *CFGFE2
  583. 39370  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの内容に誤りがあります｡ 家計簿を終了します｡"
  584. 39380  CLOSE:WAIT 100:SYSTEM
  585. 39390 *CFGFE3
  586. 39400  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの項目に不足があります｡ 家計簿を終了します｡"
  587. 39410  CLOSE:WAIT 100:SYSTEM
  588. 39420 *CFGREAD
  589. 39430  IF EOF(1)<>0 THEN *CFGFE3
  590. 39440  LINE INPUT #1,CFG$
  591. 39450  IF LEFT$(CFG$,1)="/" THEN 39430
  592. 39460  RETURN
  593. 39470 '//////////////////////////////////////////////////
  594. 39480 '
  595. 40000 *ボタン座標:'-------------------------------------------------------
  596. 40010 DATA 2   'SWGN        スイッチグループ数 
  597. 40090 '/////////////////////////////
  598. 40100 '-------------------- メインメニュースイッチグループ
  599. 40110 '    SWN(G),SMX,SMY,SMW
  600. 40120 DATA     5 ,0.8,0.8,  0
  601. 40130 '    XB1 XB2 YB1 YB2 SWM$         SMC
  602. 40140 DATA 312,392, 42, 67',"記入･編集",0
  603. 40150 DATA 393,472, 42, 67'," 検   索 ",0
  604. 40160 DATA 473,552, 42, 67'," 分   析 ",0
  605. 40170 DATA 553,591, 42, 67'," 設   定 ",2
  606. 40180 DATA 592,630,  3, 41'," end     ",2
  607. 40500 '-------------------- スイッチグループ[2]
  608. 40510 '    SWN(G),SMX,SMY,SMW
  609. 40520 DATA     2 ,0.8,0.8,  0
  610. 40530 '    XB1 XB2 YB1 YB2 SWM$         SMC
  611. 40540 DATA 552,583, 56, 73',"  OK  ",1   01
  612. 40550 DATA 584,615, 56, 73',"  NG  ",1   02
  613. 60000 '
  614. 60010 ' 座標確認 DEBUG ROUTINE
  615. 60020 '
  616. 60030 MOUSE 0:MOUSE 1,0,0,1
  617. 60040  IF MOUSE(2,1)<>0 THEN STOP
  618. 60050  IF MOUSE(2,0)=0 THEN 60050
  619. 60060  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):LX=INT(X_M/8):LY=INT(Y_M/19)
  620. 60070  LOCATE 2,24:COLOR 7:PRINT "X=";X_M,"Y=";Y_M,"LX=";LX,"LY=";LY;
  621. 60080  GOTO 60040
  622. 61000 ' 
  623.